Monster Media 1996 #15/Monster Media Number 15 (Monster Media)(July 1996).ISO/wildcat/net_port.zip/NETMPORT.WCX

Wildcat! WCX | 1996-04-19 | 6KB | 467 lines

'! Decompiled with wccNosy version 4.20f (freeware)
'! Input File: in.wcx  5798 bytes  03/09/122  08:19:18am
'! Code Segment Size  :4967 bytes
'! Data Segment Size  :5435 bytes
'! String Segment Size:831 bytes
'! Compiled with WCC version 4.12

      Type Type26
        s0 As String*36
        s36 As String*36
        s72 As String*72
        Filler144(1 To 22) As Byte
        s166 As String*1
        s167 As String*1
        Filler168(1 To 6) As Byte
        s174 As String*1
        s175 As String*1
      End Type

      Declare Function Func4030(l65534 As Long, l65532 As Long) As Integer
      Declare Sub Sub4654(s65534 As String)

      Dim s4463 As String
      Dim l4467 As Long
      Dim i4471 As Integer
      Dim s4473 As String*1
      Dim s4474 As String
      Dim s4478 As String
      Dim s4482 As String
      Dim s4486 As String
      Dim s4490 As String
      Dim mh4494 As MessageHeader
      Dim s4816 As String
      Dim s4820 As String
      Dim s4824 As String
      Dim s4828 As String
      Dim s4832 As String
      Dim s4836 As String
      Dim i4840 As Integer
      Dim w4842 As Word
      Dim i4844 As Integer
      Dim i4846 As Integer
      Dim i4848 As Integer
      Dim w4850 As Word
      Dim i4852 As Integer
      Dim i4854 As Integer
      Dim i4856 As Integer
      Dim w4858 As Word
      Dim i4860 As Integer
      Dim i4862 As Integer
      Dim i4864 As Integer
      Dim w4866 As Word
      Dim i4868 As Integer
      Dim i4870 As Integer
      Dim i4872 As Integer
      Dim s4874 As String*1
      Dim s4875 As String*1
      Dim s4876 As String*1
      Dim s4877 As String
      Dim s4885 As String
      Dim s4889 As String
      Dim s4893 As String
      Dim i4897 As Integer
      Dim i4899 As Integer
      Dim i4901 As Integer
      Dim i4903 As Integer
      Dim i4905 As Integer
      Dim i4907 As Integer
      Dim i4909 As Integer
      Dim i4911 As Integer
      Dim i4913 As Integer
      Dim i4915 As Integer
      Dim i4917 As Integer
      Dim t26_4919 As Type26
      Dim s5109 As String*190
      Dim s5299 As String
      Dim s5303 As String
      Dim s5307(0 To 30) As String
      Dim i5431 As Integer
      Dim i5433 As Integer

      Dim l65520_ As Long
      Dim i65524_ As Integer
      Dim l65526_ As Long
      Dim i65530_ As Integer
      Dim l65532_ As Long '! Temporary

      s4463 = "V1.08ß"
      GoSub 74
      GoSub 129
      GoSub 838
      GoSub 2823
      End
   74 EnablePages 0
      i4471 = 0
      l4467 = 0
      i4907 = 0
      s4874 = Chr(0)
      s4875 = Chr(13)
      s4876 = Chr(1)
      Return
  129 s4885 = ProgPath + "NetMPort.CFG"
      If ParamCount > 0 Then
        s4885 = ParamStr(1)
      End If
  164 s4889 = TempPath + "TEMPFILE.TXT"
      If Not Exists(s4885) Then
        Cls
        Locate 10, 5
        Print "I can't find your " + s4885
        Pause
        End
      End If
  222 i5431 = 0
      Open s4885 For Input As 1
      Input #1, s4474
      Input #1, s4478
      Input #1, s4482
      Input #1, s4486
      Input #1, s4490
      Input #1, l4467
  290 Do While Not EOF(1)
        Input #1, s4877
        If Trim(s4877) <> "" And Left(s4877, 1) <> ";" Then
          i5431 = i5431 + 1
          s5307(i5431) = Trim(UCase(s4877))
        End If
  400 Loop
  406 Close 1
      i4471 = 0
      If Func4030(l4467, (10937)) Then
        i4471 = -1
      End If
  456 s4877 = "NetMPort " + s4463 + ", UNREGISTERED"
      If i4471 Then
        s4877 = "NetMPort " + s4463 + ", Registered to " + MakeWild.RegString
      End If
  524 Cls
      Locate 0, 0
      Print "@NOPAUSE@"
      Print s4877
      Print "OmniBBS Systems (c)"
      Print "Charles Meadows"
      UpdateScreen
      If Right(s4486, 1) <> "\" Then
        s4486 = s4486 + "\"
      End If
  607 s4490 = Trim(UCase(s4490))
      If s4490 <> "LOG" And s4490 <> "NOLOG" Then
        s4490 = "LOG"
      End If
  660 Print " "
      Print "Verifing existance of your netmail directory"
      UpdateScreen
      s4877 = s4486 + "NetMPort.TsT"
      Open s4877 For Output As 1
      Print #1, " "
      Close 1
      If Not Exists(s4877) Then
        Cls
        Locate 10, 5
        Print "I can't find your " + s4486 + "Netmail Directory!"
        Pause
        End
      End If
  781 Del s4877
      Sub4654(s4482)
      w4842 = i4840
      w4850 = i4848
      w4858 = i4856
      w4866 = i4864
      Return
  838 Print " "
      Print "Reading Netmail messages"
      UpdateScreen
  885 For i4872 = 1 To Val(s4478) Step 1
        s4877 = Str(i4872)
        s4893 = s4486 + Trim(s4877) + ".MSG"
        If Exists(s4893) Then
          Print
          Print "Opening "; s4893
          UpdateScreen
          Open s4893 For Random As 1 Len = 190 '! This value should probably be replaced with a "SizeOf" expression
          Get 1, -1, t26_4919 '! 190 bytes
          s5109 = " "
          If Not EOF(1) Then
            Get 1, -1, s5109 '! 190 bytes
          End If
 1073     Close 1
          GoSub 1114
          GoSub 1773
        End If
 1090 Next
 1113 Return
 1114 s4816 = ""
      s4828 = ""
      s4832 = ""
      s4836 = ""
      s4824 = ""
      s4820 = ""
      If Mid(s5109, 1, 1) = s4876 Then
        s4877 = ""
        i4911 = 2
        Do
 1211     If Mid(s5109, i4911, 1) = s4875 Then
            If Mid(s4877, 1, 1) = "F" And s4820 = "" Then
              s4820 = s4877
              s4877 = ""
            End If
 1295       If Mid(s4877, 1, 1) = "I" And s4828 = "" Then
              s4828 = s4877
              s4877 = ""
            End If
 1349       If Mid(s4877, 1, 1) = "M" And s4832 = "" Then
              s4832 = s4877
              s4877 = ""
            End If
 1403       If Mid(s4877, 1, 1) = "P" And s4816 = "" Then
              s4816 = s4877
              s4877 = ""
            End If
 1457       If Mid(s4877, 1, 1) = "R" And s4836 = "" Then
              s4836 = s4877
              s4877 = ""
            End If
 1511       If Mid(s4877, 1, 1) = "T" And s4824 = "" Then
              s4836 = s4877
              s4877 = ""
            End If
 1565       i4911 = i4911 + 1
            If Mid(s5109, i4911, 1) <> s4876 Then
              Return
            End If
          End If
 1610     If Mid(s5109, i4911, 1) <> s4875 And Mid(s5109, i4911, 1) <> s4876 Then
            s4877 = s4877 + Mid(s5109, i4911, 1)
          End If
 1692     i4911 = i4911 + 1
          If i4911 = 255 Then
            i4911 = 0
          End If
 1727     If i4911 > Len(Trim(s5109)) Then
            i4911 = 0
          End If
 1758   Loop Until i4911 = 0
      End If
 1772 Return
 1773 If s4828 <> "" Then
        s4877 = ""
        s4473 = ""
        i4913 = 5
        Do
 1817     i4913 = i4913 + 1
          s4473 = Mid(s4828, i4913, 1)
          i4901 = InStr(1, ".:/1234567890", s4473)
          If i4901 > 0 Then
            s4877 = s4877 + s4473
          End If
 1902   Loop Until i4901 = 0
        s5303 = s4877
        Sub4654(s4877)
        i4846 = i4840
        i4854 = i4848
        i4862 = i4856
        i4870 = i4864
        s4877 = ""
        s4473 = ""
        Do
 1993     i4913 = i4913 + 1
          s4473 = Mid(s4828, i4913, 1)
          i4901 = InStr(1, ".:/1234567890", s4473)
          If i4901 > 0 Then
            s4877 = s4877 + s4473
          End If
 2078   Loop Until i4901 = 0
        s5299 = s4877
        Sub4654(s4877)
        i4844 = i4840
        i4852 = i4848
        i4860 = i4856
        i4868 = i4864
        GoSub 2544
        Return
      End If
 2156 If s4832 <> "" Then
        s4877 = ""
        s4473 = ""
        i4899 = 7
        Do
 2200     i4899 = i4899 + 1
          s4473 = Mid(s4832, i4899, 1)
          i4901 = InStr(1, ".:/1234567890", s4473)
          If i4901 > 0 Then
            s4877 = s4877 + s4473
          End If
 2285   Loop Until i4901 = 0
        s5299 = s4877
        Sub4654(s4877)
        i4844 = i4840
        i4852 = i4848
        i4860 = i4856
        i4868 = i4864
        i4846 = i4844
        i4854 = Val("$" + Right(Hex(Asc(t26_4919.s175)), 2) + Right(Hex(Asc(t26_4919.s174)), 2))
        i4862 = Val("$" + Right(Hex(Asc(t26_4919.s167)), 2) + Right(Hex(Asc(t26_4919.s166)), 2))
        i4870 = 0
        s5303 = Str(i4846) + ":" + Str(i4854) + "/" + Str(i4862)
        GoSub 2544
        Return
      End If
 2543 Return
 2544 GoSub 2974
      If Trim(s5303) = Trim(s4482) And i5433 = 0 Then
        GoSub 3180
        Open s4893 For Input As 1
        Do
 2607     Input #1, s4877
        Loop Until InStr(1, s4877, "INTL ") > 0 Or InStr(1, s4877, "PID") > 0 Or InStr(1, s4877, "TOPT") > 0 Or InStr(1, s4877, "TID") > 0 Or InStr(1, s4877, "REPLY") > 0 Or InStr(1, s4877, "MSGID") > 0 And Not EOF(1)
        i4909 = 0
        GoSub 3418
        Close 1
        Join Val(s4474)
        i4915 = GetHighMessage
        AddMessage(mh4494, s4889, "", Val(s4474))
        Join Val(s4474)
        Del s4889
        GoSub 3515
      End If
 2822 Return
 2823 s4877 = "NetMPort UNREGISTERED!, Imported " + Str(i4907) + " messages, using " + s4885
      If i4471 Then
        s4877 = "NetMPort Registered!, Imported " + Str(i4907) + " messages, using " + s4885
      End If
 2898 Print " "
      Print s4877
      UpdateScreen
      If i4907 > 0 And s4490 = "LOG" Then
        ActivityLog s4877
      End If
 2952 Print " "
      Print "Done with NetMPort"
      UpdateScreen
      Return
 2974 i5433 = 0
 3004 For i4917 = 1 To i5431 Step 1
        If s5307(i4917) = Trim(UCase(t26_4919.s36)) Or s5307(i4917) = Trim(UCase(s5299)) Then
          i5433 = -1
        End If
 3156 Next
 3179 Return
 3180 mh4494.FidoFromZone = i4844
      mh4494.FidoFromNet = i4852
      mh4494.FidoFromNode = i4860
      mh4494.FidoFromPoint = i4868
      mh4494.FidoToZone = i4846
      mh4494.FidoToNet = i4854
      mh4494.FidoToNode = i4862
      mh4494.FidoToPoint = i4870
      mh4494.From = Trim(UCase(t26_4919.s0))
      mh4494.To = Trim(UCase(t26_4919.s36))
      mh4494.Subject = t26_4919.s72
      mh4494.Flags = mh4494.Flags Or 1
      mh4494.Flags = mh4494.Flags Or 2048
      Return
 3418 Open s4889 For Output As 2
 3437 Do While Not EOF(1)
        i4909 = i4909 + 1
        Input #1, s4877
        If Left(s4877, 1) <> s4876 Then
          Print #2, s4877
        End If
 3503 Loop
 3509 Close 2
      Return
 3515 If i4915 = GetHighMessage Then
        s4877 = " Not able to add message in " + s4474
        Print " "
        Print s4877
        ActivityLog s4877
        s4877 = "You might wait to run WCREPAIR on the conference!"
        Print s4877
        UpdateScreen
        ActivityLog s4877
      End If
 3597 If i4915 <> GetHighMessage Then
        i4915 = GetHighMessage
        s4877 = Str(i4909) + " line message left in " + s4474
        Print " "
        Print s4877
        s4877 = "  Msg #" + Str(GetHighMessage) + " to " + UCase(mh4494.To)
        Print s4877
        UpdateScreen
        If s4490 = "LOG" Then
          s4877 = Str(i4909) + " line message left in " + s4474
          ActivityLog s4877
          s4877 = "  Msg #" + Str(GetHighMessage) + " to " + UCase(mh4494.To)
          ActivityLog s4877
        End If
 3808   i4907 = i4907 + 1
        Del s4893
      End If
 3829 Return

'! Called 1 time
      Function Func4030(l65534 As Long, l65532 As Long) As Integer
        Dim l65431 As Long
        Dim i65435 As Integer
        Dim l65437 As Long
        Dim i65441 As Integer
        Dim l65443 As Long
        Dim i65447 As Integer
        Dim s65453 As String*7
        Dim s65460 As String*30
        Dim s65490 As String*30
        Dim l65520 As Long
        Dim l65524 As Long
        Dim i65528 As Integer

        s65490 = Trim(UCase(MakeWild.BBSName))
        s65460 = ""
 4100   For i65528 = 1 To Len(s65490) Step 1
          s65453 = Mid(s65490, i65528, 1)
          If Trim(s65453) <> "" Then
            s65460 = s65460 + s65453
          End If
 4214   Next
 4237   l65524 = 0
 4271   For i65528 = 1 To Len(s65460) Step 1
          l65524 = l65524 + Asc(Mid(s65460, i65528, 1))
        Next
 4375   s65453 = Trim(UCase(MakeWild.RegString))
        l65520 = 0
 4432   For i65528 = 1 To Len(s65453) Step 1
          l65520 = l65520 + Asc(Mid(s65453, i65528, 1))
        Next
 4536   l65520 = l65520 + l65524
        l65520 = l65520 * 7
        l65520 = l65520 * l65532
        l65520 = l65520 + l65532
        If l65520 = l65534 Then
          Func4030 = - 1
        Else
 4640     Func4030 = 0
        End If
 4646
      End Function

'! Called 4 times
      Sub Sub4654(s65534 As String)
        i4897 = InStr(1, s65534, ":")
        i4899 = InStr(i4897, s65534, "/")
        i4901 = InStr(i4899, s65534, ".")
        i4903 = Len(s65534)
        i4905 = i4899 - i4897 + 1
        i4840 = Val(Left(s65534, i4897 - 1))
        i4848 = Val(Mid(s65534, i4897 + 1, i4905))
        If i4901 = 0 Then
          i4856 = Val(Mid(s65534, i4899 + 1, i4903))
          i4864 = 0
        Else
 4881     i4905 = i4901 - i4899 + 1
          i4856 = Val(Mid(s65534, i4899 + 1, i4905))
          i4864 = Val(Mid(s65534, i4901 + 1, i4903))
        End If
 4964
      End Sub